home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PBLIB1
/
UNITS
/
PBWIND.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-03
|
12KB
|
421 lines
UNIT PbWIND;
INTERFACE
uses CRT, PbCRT, PbMISC, PbOBJS;
{
Description : CRT windows
Author : Howard Richoux
Date : 1/20/94
Last revised: 2/21/94 - added PopUp logic use PopUp instead of DrawFrame
2/21/94 - added DisplayTextFile
Application : IBM PC and compatibles, done in Turbo Pascal 7
Status : Placed in the Public Domain by HNR Software 1/29/1994
Published in: none
}
type WINDOW_object = object
x1,y1,x2,y2 : byte; { define box }
ul,ur,ll,lr : char; { corner characters }
ls,rs,ts,bs : char; { top,sides,bottom characters }
border : boolean;
active : boolean;
scrollflag : boolean; { internal bookkeepint }
saveflag : boolean;
lines : STRA_object;
CRTSave : CRTSaveRec;
curr,linewidth,numlines : integer;
currpage : integer;
cursx,cursy : byte; { whenever }
cursxsav, cursysav, attrsave : byte; { Init time }
toplbl,botlbl : string[40];
visfirst,vislast : integer;
Procedure init(xx1,yy1,xx2,yy2 : byte; savelines : integer);
Procedure ReCompute;
Procedure ReFreshScreen;
Procedure SetCornerChars(uul,uur,lll,llr : char);
Procedure SetSideChars(lls,rrs,tts,bbs : char);
Procedure SetLabels(topl,botl : string);
Procedure BigWindow; { 1,1,80,25 - absolute coordinates }
Procedure SmallWindow; { x1,y1,x2,y2 - relative coordinates }
Procedure StretchWindow; { special y2 for writing last line}
Procedure ClrScr; { Data window ONLY }
Procedure OUTln(s : string);
Function ScreenLine (y : integer) : integer;
Procedure DisplayLineY (x,y : integer);
Procedure OUTXY (x,y : integer; s : string);
Procedure displaypagefromN(l : integer);
Procedure DrawFrame;
Procedure PopUp;
Procedure load (filename : string);
Procedure SaveCursor;
Procedure RestoreCursor;
Procedure Scroll;
Procedure ScrollBack1;
Procedure pause;
Procedure done;
end;
Procedure DisplayTextFile(filename : string; x0,y0,x1,y1,c : byte);
{[WINDOW] Displays a file in a window (remember 1,1,80,24 max)}
{SECTION .ZIMPLEMENTATION }
IMPLEMENTATION
Procedure WINDOW_object.init(xx1,yy1,xx2,yy2 : byte; savelines : integer);
begin
x1 := xx1; y1 := yy1; x2 := xx2; y2 := yy2;
lines.init(savelines);
SetCornerChars(chr(201),chr(187),chr(200),chr(188));
SetSideChars(chr(186),chr(186),chr(205),chr(205));
SetLabels(' <toplabel> ',' <bottomlabel> ');
cursxsav := CRT.whereX; cursysav := CRT.whereY; Attrsave := CRT.TEXTATTR;
curr := 1; currpage := 1;
visfirst := 1;
border := true;
active := true;
scrollflag := false;
saveflag := true;
ReCompute;
end;
Procedure WINDOW_object.ReCompute;
begin
linewidth := (x2 - x1)+1;
numlines := (y2 - y1)+1;
if border then
begin
linewidth := linewidth - 2;
numlines := numlines - 2;
end;
if visfirst < 1 then visfirst := 1;
if visfirst > lines.arraymax then visfirst := lines.arraymax;
vislast := visfirst + numlines - 1;
if vislast > lines.arraymax then vislast := lines.arraymax;
end;
Procedure WINDOW_object.done;
begin
lines.done;
RestoreCRT(CRTSave); {PbCRT will figure out if actually saved }
CRT.window(1,1,80,25); {make full screen }
CRT.TEXTATTR := attrsave; {restore text colors }
CRT.gotoxy(cursxsav,cursysav);
end;
Procedure WINDOW_object.pause;
var ch : char;
begin
while not keypressed do begin end;
ch := readkey;
end;
Procedure WINDOW_object.BigWindow; { 1,1,80,25 - absolute coordinates }
begin
if not active then exit;
CRT.window(1,1,80,25); {make full screen }
end;
Procedure WINDOW_object.SmallWindow; { relative coordinates }
begin
if not active then exit;
if border then
CRT.window(x1+1,y1+1,x2-1,y2-1)
else CRT.window(x1,y1,x2,y2);
end;
Procedure WINDOW_object.StretchWindow; { relative coordinates }
begin
if not active then exit;
if border then
CRT.window(x1+1,y1+1,x2-1,y2)
else CRT.window(x1,y1,x2,y2);
end;
Procedure WINDOW_object.ClrScr;
begin
scrollflag := false;
if not active then exit;
SmallWindow;
CRT.Clrscr;
end;
Procedure WINDOW_object.SaveCursor;
begin
cursx := CRT.whereX;
cursy := CRT.whereY;
end;
Procedure WINDOW_object.RestoreCursor;
begin
CRT.gotoXY(cursx,cursy);
end;
Procedure WINDOW_object.SetCornerChars(uul,uur,lll,llr : char);
begin
ul := uul; ur := uur; ll := lll; lr := llr;
end;
Procedure WINDOW_object.SetSideChars(lls,rrs,tts,bbs : char);
begin
ls := lls; rs := rrs; ts := tts; bs := bbs;
end;
Procedure WINDOW_object.SetLabels(topl,botl : string);
var s : string[60];
begin
if length(topl) < (linewidth -3) then toplbl := topl
else toplbl := leftstr(topl,linewidth-4);
if length(botl) < (linewidth -3) then botlbl := botl
else botlbl := leftstr(botl,linewidth-4);
end;
Procedure WINDOW_object.DrawFrame;
var i,l:integer;
begin
if not active then exit;
if not border then exit;
BigWindow; {Use ABSOLUTE coordinates }
PromptColor;
CRT.gotoxy(x1,y1);
write(ul);
for i:=x1+1 to x2-1 do write(ts); {top row}
write(ur);
for i:=y1+1 to y2-1 do
begin
CRT.gotoxy(x1,i); write(ls);
CRT.gotoxy(x2,i); write(rs);
end;
CRT.gotoxy(x1,y2); write(ll);
for i:=x1+1 to x2-1 do write(bs); {bottom row}
write(lr);
{ top and bottom labels }
DataColor;
if toplbl <> '' then
begin
l := 1;
if length(toplbl) < (linewidth - 2) then
l := ((x1 + (linewidth div 2)) - (length(toplbl) div 2)) - 1;
CRT.gotoxy(l,y1);
write(toplbl);
end;
if botlbl <> '' then
begin
l := 1;
if length(botlbl) < (linewidth - 2) then
l := ((x1 + (linewidth div 2)) - (length(botlbl) div 2)) - 1;
CRT.gotoxy(l,y2);
write(botlbl);
end;
end;
Procedure WINDOW_object.PopUp;
begin
if not active then exit;
CRT.window(x1,y1,x2,y2); { set to gross window size }
SaveCRT(CRTSave);
DrawFrame;
SmallWindow;
ClrScr;
end;
Procedure WINDOW_object.load(filename : string);
begin
lines.load(filename);
end;
Procedure WINDOW_object.ScrollBack1;
begin
if not active then exit;
DataColor;
ScrollDown(1,x1+1,y1+1,x2-1,y2-1,TextAttr);
end;
Procedure WINDOW_object.Scroll;
begin
if not active then exit;
DataColor;
if scrollflag then
ScrollUp(1,x1+1,y1+1,x2-1,y2-1,TextAttr);
end;
Function WINDOW_object.ScreenLine(y : integer) : integer;
var yy : integer;
begin
yy := 0;
if y >= visfirst then
begin
yy := (y - visfirst) + 1;
if yy > vislast then yy := 0;
end;
ScreenLine := yy;
end;
Procedure WINDOW_object.DisplayLineY(x,y : integer);
var xx,yy, scrnY : integer;
s : string;
begin
xx := x; yy := y;
if y > lines.arraymax then yy := lines.arraymax;
if y < 1 then yy := 1;
if active then
begin
s := lines.fetchN(yy);
{+' ['+integerstr(visfirst,3)+
' '+integerstr(vislast,3)+']'; }
scrnY := ScreenLine(yy);
if scrnY > 0 then
begin
StretchWindow;
DataColor;
CRT.gotoxy(xx,scrnY);
write(leftstr(s,(linewidth-xx)+1));
CRT.gotoxy(linewidth,scrnY);
end;
end;
end;
Procedure WINDOW_object.OUTXY(x,y : integer; s : string);
var xx,yy, scrnY : integer;
begin
yy := y; xx := x;
if y > lines.arraymax then yy := lines.arraymax;
if y < 1 then yy := 1;
if saveflag then lines.storeN(yy,s);
DisplayLineY(xx,yy);
end;
Procedure WINDOW_object.displaypagefromN(l : integer);
var i,n,yy : integer;
s : string;
begin
SmallWindow;
clrscr;
visfirst := l;
recompute;
for n := visfirst to vislast do
begin
DisplayLineY(1,n);
end;
end;
Procedure WINDOW_object.OUTln(s : string);
begin
if saveflag then lines.appendpush(s);
if curr < numlines then
begin
if active then
begin
SmallWindow;
CRT.gotoxy(1,curr); write(leftstr(s,linewidth));
gotoxy(linewidth,curr);
end;
inc(curr);
visfirst := curr - numlines + 1;
recompute;
end
else begin
Scroll;
scrollflag := true;
if active then
begin
StretchWindow;
CRT.gotoxy(1,curr); write(leftstr(s,linewidth));
gotoxy(linewidth,curr);
end;
visfirst := curr - numlines + 1;
recompute;
end;
end;
Procedure WINDOW_object.RefreshScreen;
var i,j,k : integer;
s : string;
begin
active := true;
ReCompute;
DrawFrame;
ClrScr;
displayPageFromN(visfirst);
end;
Procedure DisplayTextFile(filename : string; x0,y0,x1,y1,c : byte);
var cmd,lnstat : string[20];
var q : WINDOW_object;
begin
cmd := '?CONTINUE';
SetColorScheme(c);
q.init(x0,y0,x1,y1,1000);
q.setlabels(' '+filename+' ','');
q.PopUp;
q.smallwindow;
q.load(filename);
lnstat := '(' + integerstr(q.visfirst,4) + '/' +
integerstr(q.lines.count,4) + ')';
removeblanks(lnstat);
q.setlabels(' '+filename+' ',
' Pg&Arr to view, Esc to quit '+lnstat+' ');
q.refreshscreen;
while (cmd <> '?ESCAPE') and (cmd <> 'QUIT') do
begin
GetKeyCmd(cmd);
if cmd = '?UPARR' then dec(q.visfirst)
else if cmd = '?DOWNARR' then inc(q.visfirst)
else if cmd = '?DOWN' then q.visfirst := q.visfirst + q.numlines
else if cmd = '?UP' then q.visfirst := q.visfirst - q.numlines
else if cmd = '?HOME' then q.visfirst := 1
else if cmd = '?END' then q.visfirst := (q.lines.count-q.numlines)+1
else begin
end;
lnstat := '(' + integerstr(q.visfirst,4) + '/' +
integerstr(q.lines.count,4) + ')';
removeblanks(lnstat);
q.setlabels(' '+filename+' ',
' Pg&Arr to view, Esc to quit '+lnstat+' ');
q.refreshscreen;
end;
q.done;
end;
{SECTION ZInitialization }
begin {Initialization}
end.